unit EMSQBDsgn;

{$I QBuilderVerCtrl.inc}

interface

uses
  {$IFDEF VCL16}
    DesignIntf,
    DesignEditors,
    Winapi.Windows,
    System.Classes,
    Vcl.Dialogs;
  {$ELSE}
    {$IFNDEF VCL6}
      DsgnIntf,
    {$ELSE}
      DesignIntf,
      DesignEditors,
    {$ENDIF}
    Windows,
    Classes,
    Dialogs;
  {$ENDIF}

type

  TOperatorsProperty = class(TPropertyEditor)
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure Edit; override;
  end;

  TQBAboutProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure Edit; override;
  end;

  TQBVersionProperty = class(TQBAboutProperty)
  public
    function GetValue: string; override;
  end;

  TQBEditor = class(TDefaultEditor)
  public
    function GetVerbCount: integer; override;
    function GetVerb(Index: integer): string; override;
    procedure ExecuteVerb(Index: integer); override;
    procedure Edit; override;
  end;

  TQBHKEYProperty = class(TIntegerProperty)
  private
    function InternalGetValue(KeyValue: HKEY): string;
    procedure GetValueList(List: TStrings);
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  TQBIniFileNameProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

implementation

uses
  {$IFDEF VCL16}
    Vcl.Controls,
    System.SysUtils,
    System.TypInfo,
  {$ELSE}
    Controls,
    SysUtils,
    TypInfo,
  {$ENDIF}
  QBOpersEditor,
  QBParser,
  EMSQBAbout,
  QBResource,
  QBWindow,
  QBStringTypes;

{ TOperatorsListProperty }

procedure TOperatorsProperty.Edit;
var
  Dlg: TQBOperatorsEditor;
begin
  Dlg:= TQBOperatorsEditor.Create(nil);
  try
    Dlg.Caption := GetName + ' - ' + Dlg.Caption;
    Dlg.SourceList.Assign(TQBOperators(GetOrdValue));
    if Dlg.ShowModal = mrOK
      then SetOrdValue(LongInt(Dlg.SourceList));
  finally
    Dlg.Free;
  end;
end;

function TOperatorsProperty.GetAttributes: TPropertyAttributes;
begin
  Result:= [paDialog];
end;

function TOperatorsProperty.GetValue: string;
begin
  Result:= QBFormat('(%s)', [ GetPropType^.Name ] );
end;

{ TQBAboutProperty }

procedure TQBAboutProperty.Edit;
begin
  ShowAboutForm();
end;

function TQBAboutProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paReadOnly, paDialog];
end;

function TQBAboutProperty.GetValue: string;
begin
  Result := QBFormat('(%s)', [rsAboutCaption]);;
end;

{ TQBEditor }

procedure TQBEditor.Edit;
begin
  ShowAboutForm();
end;

procedure TQBEditor.ExecuteVerb(Index: integer);
begin
  if Index = 0
    then ShowAboutForm()
    else inherited ExecuteVerb(Index);
end;

function TQBEditor.GetVerb(Index: integer): string;
begin
  case Index of
    0: Result := QBFormat('%s...', [rsAboutCaption]);
    else Result := '';
  end;
end;

function TQBEditor.GetVerbCount: integer;
begin
  Result := 1;
end;

{ TQBVersionProperty }

function TQBVersionProperty.GetValue: string;
begin
  Result := sVersionNumber;
end;

{ TQBHKEYProperty }

function TQBHKEYProperty.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes() + [paValueList, paRevertable];
end;

function TQBHKEYProperty.GetValue: string;
begin
  Result := InternalGetValue(GetOrdValue());
end;

procedure TQBHKEYProperty.GetValueList(List: TStrings);
begin
  if not Assigned(List) then Exit;
  List.Clear();
  List.Add(InternalGetValue(HKEY_CLASSES_ROOT));
  List.Add(InternalGetValue(HKEY_CURRENT_USER));
  List.Add(InternalGetValue(HKEY_LOCAL_MACHINE));
  List.Add(InternalGetValue(HKEY_USERS));
  List.Add(InternalGetValue(HKEY_PERFORMANCE_DATA));
  List.Add(InternalGetValue(HKEY_CURRENT_CONFIG));
  List.Add(InternalGetValue(HKEY_DYN_DATA));
end;

procedure TQBHKEYProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Values: TStrings;
begin
  Values := TStringList.Create();
  try
    GetValueList(Values);
    for I := 0 to Values.Count - 1 do
      Proc(Values[I]);
  finally
    Values.Free();
  end;
end;

function TQBHKEYProperty.InternalGetValue(KeyValue: HKEY): string;
begin
  case KeyValue of
    HKEY_CLASSES_ROOT :
      Result := 'HKEY_CLASSES_ROOT';
    HKEY_LOCAL_MACHINE :
      Result := 'HKEY_LOCAL_MACHINE';
    HKEY_USERS :
      Result := 'HKEY_USERS';
    HKEY_PERFORMANCE_DATA :
      Result := 'HKEY_PERFORMANCE_DATA';
    HKEY_CURRENT_CONFIG :
      Result := 'HKEY_CURRENT_CONFIG';
    HKEY_DYN_DATA :
      Result := 'HKEY_DYN_DATA';
  else
    Result := 'HKEY_CURRENT_USER';
  end;
end;

procedure TQBHKEYProperty.SetValue(const Value: string);
var
  QueryBuilder: TCustomQueryBuilder;
begin
  QueryBuilder := TCustomQueryBuilder(GetComponent(0));
  if not Assigned(QueryBuilder) then begin
    inherited SetValue(InternalGetValue(HKEY_CURRENT_USER));
    Exit;
  end;
  if CompareText(InternalGetValue(HKEY_CLASSES_ROOT), Value) = 0 then
    inherited SetValue(IntToStr(HKEY_CLASSES_ROOT))
  else if CompareText(InternalGetValue(HKEY_LOCAL_MACHINE), Value) = 0 then
    inherited SetValue(IntToStr(HKEY_LOCAL_MACHINE))
  else if CompareText(InternalGetValue(HKEY_USERS), Value) = 0 then
    inherited SetValue(IntToStr(HKEY_USERS))
  else if CompareText(InternalGetValue(HKEY_PERFORMANCE_DATA), Value) = 0 then
    inherited SetValue(IntToStr(HKEY_PERFORMANCE_DATA))
  else if CompareText(InternalGetValue(HKEY_CURRENT_CONFIG), Value) = 0 then
    inherited SetValue(IntToStr(HKEY_CURRENT_CONFIG))
  else if CompareText(InternalGetValue(HKEY_DYN_DATA), Value) = 0 then
    inherited SetValue(IntToStr(HKEY_DYN_DATA))
  else
    inherited SetValue(IntToStr(HKEY_CURRENT_USER));
end;

{ TQBIniFileNameProperty }

procedure TQBIniFileNameProperty.Edit;
var
  Dlg: TSaveDialog;
begin
  Dlg := TSaveDialog.Create(nil);
  try
    Dlg.DefaultExt := 'ini';
    Dlg.Filter := rsIniFiles + ' (*.ini)|*.ini|' + rsAllFiles + ' (*.*)|*.*';
    Dlg.FileName := GetValue();
    Dlg.Options := [ofHideReadOnly, ofExtensionDifferent, ofPathMustExist,
      ofEnableSizing];
    if Dlg.Execute() then
      SetValue(Dlg.FileName);
  finally
    Dlg.Free();
  end;
end;

function TQBIniFileNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes() + [paDialog];
end;

end.
